home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / TERMBASE.I < prev    next >
Encoding:
Modula Implementation  |  1990-07-16  |  3.0 KB  |  117 lines
  1. IMPLEMENTATION MODULE TermBase;
  2. (*$Y+, L-,R-,M-*)
  3.  
  4. FROM SYSTEM IMPORT ASSEMBLER;
  5.  
  6. (*
  7.   27.07.89 TT  WriteString optimiert
  8. *)
  9.  
  10. FROM SYSTEM IMPORT LONGWORD;
  11.  
  12. PROCEDURE WriteString (REF str: ARRAY OF CHAR);
  13.   BEGIN
  14.     ASSEMBLER
  15.         MOVEM.L D4/A4,-(A7)
  16.         MOVE.W  -(A3),D4
  17.         MOVE.L  -(A3),A4
  18.         CLR.W   -(A7)
  19.         MOVE.L  #$00030002,-(A7)
  20.       l MOVE.W  #$0003,(A7)     ; muß wegen eines Fehlers in TOS 1.4 (8.8.88)
  21.                                 ; immer wieder gesetzt werden
  22.         MOVE.B  (A4)+,5(A7)
  23.         BEQ     e
  24.         TRAP    #13
  25.         DBRA    D4,l
  26.       e ADDQ.L  #6,A7
  27.         MOVEM.L (A7)+,D4/A4
  28.     END
  29.   END WriteString;
  30.  
  31. PROCEDURE WriteVisible (REF str: ARRAY OF CHAR);
  32.   BEGIN
  33.     ASSEMBLER
  34.         MOVEM.L D4/A4,-(A7)
  35.         MOVE.W  -(A3),D4
  36.         MOVE.L  -(A3),A4
  37.         CLR.W   -(A7)
  38.         MOVE.L  #$00030005,-(A7)
  39.       l MOVE.W  #$0003,(A7)     ; muß wegen eines Fehlers in TOS 1.4 (8.8.88)
  40.                                 ; immer wieder gesetzt werden
  41.         MOVE.B  (A4)+,5(A7)
  42.         BEQ     e
  43.         TRAP    #13
  44.         DBRA    D4,l
  45.       e ADDQ.L  #6,A7
  46.         MOVEM.L (A7)+,D4/A4
  47.     END
  48.   END WriteVisible;
  49.  
  50. PROCEDURE Busy (): BOOLEAN;
  51.   BEGIN
  52.     ASSEMBLER
  53.         MOVE.L  #$00010002,-(A7)
  54.         TRAP    #13
  55.         ADDQ.L  #4,A7
  56.         TST     D0
  57.         SNE     D0
  58.         AND     #1,D0
  59.         MOVE    D0,(A3)+
  60.     END
  61.   END Busy;
  62.  
  63. PROCEDURE GetGSX (): LONGWORD;
  64.   BEGIN
  65.     ASSEMBLER
  66.         MOVE.L  #$00020002,-(A7)
  67.         TRAP    #13
  68.         ADDQ.L  #4,A7
  69.         MOVE.L  D0,(A3)+
  70.     END
  71.   END GetGSX;
  72.  
  73. PROCEDURE GetRows (): CARDINAL;
  74.   BEGIN
  75.     ASSEMBLER
  76.         MOVE    #25,(A3)+
  77.     END
  78.   END GetRows;
  79.  
  80. PROCEDURE GetCols (): CARDINAL;
  81.   BEGIN
  82.     ASSEMBLER
  83.         PEA     u(PC)
  84.         MOVE    #38,-(A7)
  85.         TRAP    #14
  86.         ADDQ.L  #6,A7
  87.         MOVE    D0,(A3)+
  88.         RTS
  89.       u TST.B   $44C
  90.         BEQ     l
  91.         MOVEQ   #80,D0
  92.         RTS
  93.       l MOVEQ   #40,D0
  94.     END
  95.   END GetCols;
  96.  
  97. PROCEDURE InitDisplay;
  98.   BEGIN
  99.     DoWrite:= WriteString;
  100.     DoGetRows:= GetRows;
  101.     DoGetCols:= GetCols;
  102.     DoWriteCt:= WriteVisible;
  103.   END InitDisplay;
  104.  
  105. PROCEDURE InitKeyboard;
  106.   BEGIN
  107.     DoBusy:= Busy;
  108.     DoGetGSX:= GetGSX;
  109.   END InitKeyboard;
  110.  
  111. BEGIN
  112.   InitKeyboard;
  113.   InitDisplay;
  114. END TermBase.
  115. ə
  116. (* $FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$00000036$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6B$FFFC3D6BÇ$00000028T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$FFEE7ABD$FFEE7ABD$FFEE7ABD$000005B9$000008EF$000000C2$000002D2$00000055$00000034$00000028$000000A5$0000009A$000008A3$00000670$00000908$FFEE7ABD¿ÇÇ*)
  117.